COMMENT ⊗   VALID 00008 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00002 00002	
C00003 00003	CHANNEL STUFF
C00005 00004	DEFINE MAXINPLEV=3
C00010 00005	RPTR(OBJ_TOKEN) ITEMVAR PROCEDURE NEW_OBJ_TOKEN(STRING ID INTEGER V,TYPE)
C00012 00006	
C00015 00007	PROCEDURE SCAN_RESERVED_WORDS
C00016 00008	PROCEDURE SCAN_TERMINALS
C00017 ENDMK
C⊗;

BEGIN "SPTRAN"



DEFINE MAX_BYTE = 2↑12-1;
DEFINE MAX_DAT =2↑10-1;
DEFINE MAX_CLASS = 255;
DEFINE MAX_CLASS_BYTE = 1023;
DEFINE MAX_LABEL = 300;

INTEGER ARRAY BYTES[0:MAX_BYTE];
INTEGER ARRAY CLASS_BYTES[0:MAX_CLASS_BYTE];
INTEGER ARRAY CLASS_BASE[0:MAX_CLASS];

INTEGER BYTE_TOP,CLASS_TOP,CLASS_BYTE_TOP,LABEL_TOP;
INITIALIZE( LABEL_TOP←BYTE_TOP←CLASS_TOP←CLASS_BYTE_TOP←-1);

RCLASS RESERVED_WORD(ITEMVAR RWSYM;INTEGER RWTYPE;INTEGER CODE);

RCLASS OBJ_TOKEN(STRING ITEMVAR ID;INTEGER VAL,TYPE);
RCLASS STCONST(STRING ITEMVAR VAL);

LIST CLASSES,RWORDS,TERMINALS,NON_TERMINALS;

COMMENT CHANNEL STUFF;
DEFINE MAXFILES="15";
STRING ARRAY FID[0:MAXFILES];
INTEGER ARRAY EOF[0:MAXFILES];
INTEGER ARRAY BRCHAR[0:MAXFILES];


INTEGER PROCEDURE READFILE(STRING FILEID;INTEGER DMODE(0));
	BEGIN
	INTEGER CH;
	CH←GETCHAN;
	FID[CH]←FILEID;
	OPEN(CH,"DSK",DMODE,3,0,512,BRCHAR[CH],EOF[CH]);
	LOOKUP(CH,FILEID,EOF[CH]);
	IF EOF[CH] THEN 
		BEGIN
		USERERR(1,1,"LOOKUP FAILED FOR |"&FILEID&"|");
		RELEASE(CH);
		CH←-1;
		END;
	RETURN(CH);
	END;

INTEGER PROCEDURE WRITEFILE(STRING FILEID;INTEGER DMODE(0));
	BEGIN
	INTEGER CH;
	CH←GETCHAN;
	CH←GETCHAN;
	FID[CH]←FILEID;
	OPEN(CH,"DSK",DMODE,0,3,512,BRCHAR[CH],EOF[CH]);
	ENTER(CH,FILEID,EOF[CH]);
	IF EOF[CH] THEN 
		BEGIN
		USERERR(1,1,"ENTER FAILED FOR |"&FILEID&"|");
		RELEASE(CH);
		CH←-1;
		END;
	RETURN(CH);
	END;

RCLASS CHAR_REC(INTEGER CHAR);
DEFINE MAXINPLEV=3;
INTEGER ARRAY SCNCHN[1:MAXINPLEV];
STRING ARRAY SCNSTK[0:MAXINPLEV];
INTEGER INPLEV,BREAK;

RANY ITEMVAR SYM;
STRING SCNID;
INTEGER SCNVAL;


DEFINE LINBRK=1,
	BLNKBRK = 2,
	IDBRK = 3,
	STRBRK = 4;

DEFINE	UNKN_CODE = 0,
	UNDEF_SYM_CODE = -1,
	EOA_CODE = -2,
	VAL_CODE = -3,
	OBJ_TOKEN_CODE = -4;

PROCEDURE INPINIT;
	BEGIN
	SETBREAK(LINBRK,LF,CR,"INS"); ! line break;
	SETBREAK(BLNKBRK," "&FF&TAB&CR&LF,NULL,"XRN");
	SETBREAK(IDBRK,"ABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789",NULL,"KXRN");
	SETBREAK(STRBRK,""""&LF,CR,"INS");
	INPLEV←0;
	END;
REQUIRE INPINIT INITIALIZATION;

PROCEDURE NEXTLINE;
	BEGIN
	WHILE INPLEV>0 DO
		BEGIN
		IF ¬EOF[SCNCHN[INPLEV]] THEN
			BEGIN
			SCNSTK[INPLEV]←SCNSTK[INPLEV]&
				INPUT(SCNCHN[INPLEV],LINBRK);
			RETURN;
			END
		ELSE
			BEGIN
			RELEASE(SCNCHN[INPLEV]);
			INPLEV←INPLEV-1;
			END;
		END;
	OUTSTR("*");
	SCNSTK[0]←SCNSTK[0]&INCHWL&LF;
	END;

STRING PROCEDURE INSCAN(INTEGER BRKTBL;REFERENCE INTEGER BC);
	BEGIN
	WHILE ¬LENGTH(SCNSTK[INPLEV]) DO NEXTLINE;
	RETURN(SCAN(SCNSTK[INPLEV],BRKTBL,BC));
	END;

INTEGER PROCEDURE GETCHAR;
	BEGIN
	WHILE ¬LENGTH(SCNSTK[INPLEV]) DO NEXTLINE;
	C←LOP(SCNSTK[INPLEV]);
	END;

INTEGER PROCEDURE SKIPBLANKS;
	BEGIN
	! returns the first non-"blank" character;
	INTEGER C;
	STRING S;
	DO S←INSCAN(BLNKBRK,C) UNTIL C≠0;
	RETURN(C);
	END;

INTEGER PROCEDURE SCAN_TOKEN;
	BEGIN
	INTEGER C,IX;
	SIMPLE INTEGER IDDECODE;
		BEGIN
		SYM←CVSI(SCNID,C);
		IF C THEN 
			RETURN(UNDEF_SYM_CODE)
		ELSE
			RETURN(OBJ_TOKEN_CODE);
		END;
	C←SKIPBLANKS; 
	IF C="<" THEN 
		BEGIN
		IF IS_LETTER(SCNSTK[INPLEV]) THEN
			BEGIN
			EOA_FLAG←TRUE;
			SCNID←INSCAN(IDBRK,C);
			WHILE C≠">" DO
				C←GETCHAR;
			RETURN(EOA_CODE);
			END;
		END;
	IF IS_LETTER(C) THEN
		BEGIN
		! an identifier;
		SCNID←INSCAN(IDBRK,C);
		RETURN(IDDECODE);
		END;
	IF SECOND[C]≠0 THEN
		BEGIN
		IF SCNSTK[INPLEV] = SECOND[C] THEN
			BEGIN
			IX←LOP(SCNSTK[INPLEV]);
			SYM←DBL[C];
			RETURN(RESERVED_WORD:RWTYPE[∂(SYM)];
			END
		END;
	IF "0"≤SCNSTK[INPLEV]≤"9" THEN
		BEGIN
		SCNVAL←INTSCAN(SCNSTK[INPLEV],C);
		RETURN(VAL_CODE);
		END;
	IF C="""" THEN
		BEGIN
		SCNID←NULL;
		WHILE TRUE DO
			BEGIN
			C←LOP(SCNSTK[INPLEV]);
			SCNID←SCNID&INSCAN(STRBRK,C);
			IF C="""" THEN
				BEGIN
				IF SCNSTK[INPLEV]="""" THEN
					SCNID←SCNID&LOP(SCNSTK[INPLEV])
				ELSE DONE;
				END
			ELSE IF C=LF THEN
				SCNID←SCNID&CR&LF;
			RETURN(IDDECODE);
			END;
		END;
	C←SCNID←LOP(SCNSTK[INPLEV]);
	RETURN(C);
	END;

RPTR(OBJ_TOKEN) ITEMVAR PROCEDURE NEW_OBJ_TOKEN(STRING ID; INTEGER V,TYPE);
	BEGIN
	RPTR(OBJ_TOKEN) ITEMVAR T;
	INTEGER FG;
	T←CVSI(T,FG);
	IF FG THEN
		BEGIN
		T←NEW(NEW_RECORD(OBJ_TOKEN));
		OBJ_TOKEN:ID[∂(T)]←T;
		OBJ_TOKEN:VAL[∂(T)]←V;
		OBJ_TOKEN:TYPE[∂(T)]←TYPE;
		NEW_PNAME(T,ID);
		END
	ELSE
		BEGIN
		ERROR("MULTIPLE DECLARATION OF "&ID&" IGNORED);
		END;
	RETURN(T);
	END;

PROCEDURE SCAN_CLASSES;
	BEGIN
	INTEGER TOK;
	TOK←SCAN_TOKEN;
	WHILE TOK ≠ EOA_CODE DO
		BEGIN
		IF TOK=UNDEF_SYM_CODE THEN
			BEGIN
			CLASSES[∞+1]←NEW_OBJ_TOKEN(SCNID,
				(CLASS_TOP←CLASS_TOP+1)+'2000,CLASS_TYPE);
			CLASS_BASE[CLASS_TOP]←0;
			END
		ELSE
			BEGIN
			ERROR("FUNNY THING FOR A CLASS DEF -- "&SCNID);
			TOK←SCAN_TOKEN;
			CONTINUE;
			END;
		CLASSNAME←SCNID;
		IF SCNSTK[INPLEV]=":" THEN
			TOK←LOP(SCNSTK[INPLEV]) 
		ELSE
			ERROR("WARNING: NO "":"" SEEN AFTER CLASS DEF");
		WHILE (TOK←SCAN_TOKEN)≠EOA_CODE DO
			BEGIN
			IF SCNSTK[INPLEV]=":" THEN DONE;
			IF TOK=UNDEF_SYM_CODE THEN
				BEGIN
				ERROR("UNDEFINED CLASS ELEMENT FOR CLASS "
						&CLASSNAME);
				CONTINUE;
				END
			ELSE IF TOK≤0 THEN
				BEGIN
				ERROR("FUNNY CLASS ELEMENT FOR CLASS "&CLASSNAME);
				CONTINUE;
				END;
			CLASS_BYTE_TOP←CLASS_BYTE_TOP+1;
			IF CLASS_BASE[CLASS_TOP]=0 THEN
				CLASS_BASE[CLASS_TOP]←CLASS_BYTE_TOP;
			CLASS_BYTE[CLASS_BYTE_TOP]←TOK;
			END;
		END;
	END;
PROCEDURE SCAN_RESERVED_WORDS;
	BEGIN
	INTEGER TOK;
	WHILE (TOK←SCAN_TOKEN)≠EOA_CODE DO
		BEGIN
		IF TOK≠UNDEF_SYM THEN
			BEGIN
			ERROR(SCNID&" ALREADY DEFINED");
			CONTINUE;
			END;
		RWORDS[∞+1]←NEW_OBJ_TOKEN(SCNID,RWINDX←RWINDX+1,RW_TYPE);
		
		END;
	END;
PROCEDURE SCAN_TERMINALS;
	BEGIN
	END;